perm filename SOLSYS.SAI[1,BGB] blob sn#139439 filedate 1975-01-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "SOLSYS  -  A SOLAR SYSTEM SIMULATOR  -  SEPTEMBER 1972"
C00003 00003	SUBR ARC(REAL R,B,A)
C00005 00004	SUBR RADIAL (REAL R1,R2,W)
C00006 00005	α DATA SOURCE - ASTROPHYSICAL QUANTITIES, C.W.ALLEN, 1955
C00008 00006		REAL DATE
C00010 00007	α SIGNS OF THE ZODIAC
C00011 00008	SUBR INITIALIZATION
C00012 00009	SUBR SUNCENTERED
C00013 00010	SUBR XCENTERED(ITG J)
C00014 00011		INITIALIZATION
C00015 ENDMK
C⊗;
BEGIN "SOLSYS  -  A SOLAR SYSTEM SIMULATOR  -  SEPTEMBER 1972"

	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
	REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;

DEFINE DMS(D,M,S)="(π*((S/60+M)/60+D)/180)";
SAFE ITG ARRAY DPYBUF[1:2500];
REAL XL,XH,YL,YH;
REAL BEAMX,BEAMY,MAGX,MAGY,SOX,SOY;

SUBR AI(REAL X,Y);
	⊂ BEAMX←X*MAGX+SOX;
	  BEAMY←Y*MAGY+SOY;⊃;

SUBR AV(REAL X,Y);
BEGIN
	REAL X1,Y1,X2,Y2;
	X1←BEAMX;
	Y1←BEAMY;
	X2←BEAMX←X*MAGX+SOX;
	Y2←BEAMY←Y*MAGY+SOY;
	AIVECT(X1,Y1);AVECT(X2,Y2);
END;

	DEFINE INCREM(I)="I←I+1";
SUBR ARC(REAL R,B,A);
BEGIN
	REAL BXSAV,BYSAV; ITG RMAGX;
	REAL XX,X,Y,C,S,CX,CY,D; ITG M,N,I;
	BXSAV←BEAMX; BYSAV←BEAMY;

α CENTER OF THE CIRCLE;
	CX ← (BEAMX-SOX)/MAGX;
	CY ← (BEAMY-SOY)/MAGY;
	RMAGX ← ABS(R*MAGX); IF RMAGX≤1 THEN RETURN;
α START OF ARC;
	X ← COS(A)*R;
	Y ← SIN(A)*R;
	AI(CX+X,CY+Y);

α NUMBER OF STEPS DEPENDS ON CURVATURE AND ARC LENGTH;
	M ← IF RMAGX≤4 THEN 4 ELSE
	    IF RMAGX≤100 THEN 12 ELSE
	    IF RMAGX≤400 THEN 15 ELSE 18;
	N ← ABS(M*B/π) MAX 1;
α DELTA RADIANS PER STEP;
	D ← B/N;
	C ← COS(D);
	S ← SIN(D);
α WILL THE CIRCLE BE UNBROKEN;
	FOR I←1 TO N DO
	BEGIN
		XX ← C*X - S*Y;
		Y ← C*Y + S*X; X←XX;
		AV(CX+X,CY+Y);
	END;
	BEAMX ← BXSAV; BEAMY ← BYSAV;
END;
SUBR RADIAL (REAL R1,R2,W);
BEGIN "RADIAL"
	REAL BXSAV,BYSAV;
	REAL C,S,CX,CY;
	BXSAV ← BEAMX; BYSAV ← BEAMY;
	C ← COS(W);
	S ← SIN(W);
	CX ← (BEAMX-SOX)/MAGX; CY ← (BEAMY-SOY)/MAGY;
	IF R1≠R2 ∧ ABS(R2-R1)≤4 THEN RETURN;
	AI(CX+C*R1,CY+S*R1); IF R1=R2 THEN RETURN;
	AV(CX+C*R2,CY+S*R2);
	BEAMX ← BXSAV; BEAMY ← BYSAV;
END "RADIAL";
α DATA SOURCE - ASTROPHYSICAL QUANTITIES, C.W.ALLEN, 1955;

α PLANET NAMES;
	PRELOAD_WITH "SUN",
		"MERCURY","VENUS","EARTH",
		"MARS","JUPITER","SATURN",
		"URANUS","NEPTUNE","PLUTO";
	STRING ARRAY PLANET[0:9];

α SEMI-MAJOR AXIS OF ORBIT IN AU'S;
	PRELOAD_WITH 0,
		0.387099, 0.723332, 1.000,
		1.52369,  5.2028,   9.540,
		19.18,    30.07,    39.44;
	REAL ARRAY RADIUS[0:9];

α MEAN DAILY MOTION IN SECONDS OF ARC;
	DEFINE SEC=".4848136811@-5";
	PRELOAD_WITH
		14732.4202*SEC, 5767.671*SEC, 3548.1926*SEC,
		1886.5186*SEC,  299.1278*SEC, 120.456*SEC,
		42.234*SEC,     21.53*SEC,    14.29*SEC;
	REAL ARRAY SPEED[1:9];

α MEAN LONGITUDE OF PLANET AT NOON 1 JANUARY 1950;
	PRELOAD_WITH
		DMS(33,10,06), DMS(81,34,19), DMS(99,35,18),
		DMS(144,20,07),DMS(316,09,34),DMS(158,18,13),
		DMS(98,18,31), DMS(194,57,08),DMS(165,36,09);
	REAL ARRAY POSITION[1:9];
	REAL DATE;
	ITG  SECOND,MINUTE,HOUR,DAY,MONTH,YEAR;

α NAMES OF THE MONTHS;
	PRELOAD_WITH
		"JAN", "FEB", "MAR",
		"APR", "MAY", "JUN",
		"JUL", "AUG", "SEP",
		"OCT", "NOV", "DEC";
	STRING ARRAY NMONTH[1:12];

α LENGTH OF THE MONTHS - "30 DAYS HATH SEPTEMBER...";
	PRELOAD_WITH
		31,28,31, 30,30,30, 31,31,30, 31,30,31;
	ITG ARRAY LMONTH[1:12];

SUBR UPDATE;
BEGIN "UPDATE"
	DATE←DATE+1;
	DAY←DAY+1;
	IF DAY > LMONTH[MONTH] THEN ⊂ DAY←1; INCREM(MONTH);⊃;
	IF MONTH > 12 THEN ⊂ MONTH←1; INCREM(YEAR);
	LMONTH[2]← IF (YEAR MOD 4)=0 THEN 29 ELSE 28; ⊃;

	AIVECT(200,470);
	DPYSST((IF DAY≤9 THEN " "ELSE"")&
		CVS(DAY)&" "&NMONTH[MONTH]&" "&CVS(YEAR));
END "UPDATE";
α SIGNS OF THE ZODIAC;
	PRELOAD_WITH
		"ARIES ", "TAURUS", "GEMINI", "CANCER",
		"LEO", "VIRGO", "LIBRA", "SCORPIO",
		"SAGITTARIUS", "CAPRICORNUS", "AQUARIUS", "PISCES";
	STRING ARRAY ZODIAC[1:12];
SUBR INITIALIZATION;
BEGIN
ITG I;
	DPYSET(DPYBUF);
	MAGX ← MAGY ← 1;
	FOR I←1 TO 9 DO ARC(50*I,2*π,0);
	AIVECT(-511,-511);
	AVECT(511,-511);
	AVECT(511,511);
	AVECT(-511,511);
	AVECT(-511,-511);

	DPYBIG(1);
	FOR I←0 TO 11 DO 
	⊂ AIVECT(490*COS(2*π*I/12) -  5*LENGTH(ZODIAC[I+1]),
		 490*SIN(2*π*I/12));
	DPYSST(ZODIAC[I+1]);⊃;DPYBIG(2);
	DPYOUT(0);

	FOR I←1 TO 50 DO OUTSTR(↓);
	DAY←1; MONTH←1; YEAR←1950;
END;
SUBR SUNCENTERED;
BEGIN
	ITG I; REAL C,S,W;
	AIVECT(0,0);DPYSST("SUN");
	FOR I←1 TO 9 DO
	BEGIN
		W ← POSITION[I];
		C ← COS(W)*50*I;
		S ← SIN(W)*50*I;
		AIVECT(C-4,S);AVECT(C+4,S);
		AIVECT(C,S-4);AVECT(C,S+4);
		AIVECT(C,S);
		DPYSST(PLANET[I]);
	END;

END;
SUBR XCENTERED(ITG J);
BEGIN
	REAL X,Y,X0,Y0,W,R; ITG I;

	X0 ← COS(POSITION[J])*RADIUS[J];
	Y0 ← SIN(POSITION[J])*RADIUS[J];
	AIVECT(0,0);DPYSST(PLANET[J]);

	PLANET[J] ↔ PLANET[0];
	RADIUS[J] ↔ RADIUS[0];

	FOR I←1 TO 9 DO
	BEGIN
		W ← POSITION[I];
		X ← COS(W)*RADIUS[I] - X0;
		Y ← SIN(W)*RADIUS[I] - Y0;
		R ← (I*50)/SQRT(X↑2 + Y↑2);
		X ← X*R; Y ← Y*R;
		AIVECT(0,0);AVECT(X,Y);DPYSST(PLANET[I]);
	END;

	PLANET[J] ↔ PLANET[0];
	RADIUS[J] ↔ RADIUS[0];
END;
	INITIALIZATION;
WHILE TRUE DO
BEGIN
	ITG I,CHR,ICHR; REAL C,S,W;
	IF CHR=0 THEN CHR←"S";
	DPYSET(DPYBUF);
	IF CHR="S" THEN	SUNCENTERED ELSE XCENTERED(CHR LAND '17);
	FOR I←1 TO 9 DO POSITION[I] ← POSITION[I]+SPEED[I];
	UPDATE;
	DPYOUT(1);
	ICHR ← INCHRS; IF ICHR>0 THEN CHR←ICHR;
END;
END;